Movelet: Output for Paper
Virgilio Gonzenbach
10/7/2021
library(dplyr)
library(tidyr)
library(ggplot2)
library(ggpubr)
library(ggsci)
library(flextable)
source("Code/functions.R")
source("Code/summary.R")
metrics_df <- read.csv('metrics_df.csv')
metrics_df_all_n <- read.csv('metrics_df_all_n.csv')Comparisons
Number of PCs
metrics_df %>%
filter(pca == 'bothhands') %>%
mutate(npc = as.factor(npc)) %>%
group_by(patient, smooth, npc) %>%
select(Accuracy, Precision, F1.score, Sensitivity, Specificity) %>%
summarize_all(mean) %>%
ungroup() %>%
pivot_longer(-c(npc, patient, smooth), names_to = "Metric") %>%
ggplot(aes(x=Metric, y=value, color=npc)) +
geom_boxplot() +
facet_wrap(~smooth) +
theme_bw() + theme(plot.title = element_text(hjust = 0.5)) +
scale_color_lancet()
ggsave('figures/npc_boxplot.png', dpi=300)Dominant Hand vs Both Hands (w. npc=3)
metrics_df_for_plot = metrics_df %>%
filter(npc == 3 | npc == 6) %>%
mutate(npc = as.factor(npc), patient=as.factor(patient)) %>%
group_by(patient, smooth, pca) %>%
select(Accuracy, Precision, F1.score, Sensitivity, Specificity) %>%
summarize_all(mean) %>%
ungroup()
metrics_df_for_plot %>%
pivot_longer(-c(pca, patient, smooth), names_to = "Metric") %>%
mutate(pca = recode(.$pca, `bothhands` = "Both Hands", `dominanthand` = "Dominant Hand")) %>%
ggplot(aes(x=Metric, y=value, color=pca)) +
geom_boxplot() +
facet_wrap(~smooth) +
theme_bw() + theme(plot.title = element_text(hjust = 0.5)) +
scale_color_lancet() +
labs(color='PCA')
Testing differences
bothhands = metrics_df_for_plot %>%
filter(smooth=='Post-Smoothing', pca=='bothhands') %>%
select(where(is.numeric))
domhand = metrics_df_for_plot %>%
filter(smooth=='Post-Smoothing', pca=='dominanthand') %>%
select(where(is.numeric))
metrics_df_for_plot %>%
filter(smooth=='Post-Smoothing') %>%
group_split(pca)## <list_of<
## tbl_df<
## patient : factor<21c93>
## smooth : character
## pca : character
## Accuracy : double
## Precision : double
## F1.score : double
## Sensitivity: double
## Specificity: double
## >
## >[2]>
## [[1]]
## # A tibble: 10 × 8
## patient smooth pca Accuracy Precision F1.score Sensit…¹ Speci…²
## <fct> <chr> <chr> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 19 Post-Smoothing bothhands 0.688 0.958 0.721 0.612 0.933
## 2 20 Post-Smoothing bothhands 0.875 0.920 0.918 0.918 0.729
## 3 28 Post-Smoothing bothhands 0.835 0.907 0.882 0.868 0.739
## 4 32 Post-Smoothing bothhands 0.863 0.917 0.908 0.901 0.746
## 5 40 Post-Smoothing bothhands 0.666 0.862 0.756 0.680 0.616
## 6 52 Post-Smoothing bothhands 0.999 1.00 1.00 1.00 0.998
## 7 75 Post-Smoothing bothhands 0.982 0.999 0.986 0.973 0.998
## 8 86 Post-Smoothing bothhands 0.744 0.893 0.810 0.758 0.699
## 9 88 Post-Smoothing bothhands 0.874 0.880 0.918 0.963 0.634
## 10 89 Post-Smoothing bothhands 0.833 0.905 0.887 0.872 0.709
## # … with abbreviated variable names ¹Sensitivity, ²Specificity
##
## [[2]]
## # A tibble: 10 × 8
## patient smooth pca Accuracy Precis…¹ F1.sc…² Sensi…³ Speci…⁴
## <fct> <chr> <chr> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 19 Post-Smoothing dominanthand 0.659 0.866 0.712 0.653 0.678
## 2 20 Post-Smoothing dominanthand 0.821 0.890 0.882 0.875 0.637
## 3 28 Post-Smoothing dominanthand 0.842 0.896 0.894 0.893 0.689
## 4 32 Post-Smoothing dominanthand 0.925 0.931 0.952 0.974 0.774
## 5 40 Post-Smoothing dominanthand 0.700 0.926 0.773 0.675 0.790
## 6 52 Post-Smoothing dominanthand 0.999 0.999 1.00 1.00 0.998
## 7 75 Post-Smoothing dominanthand 0.998 0.997 0.999 1 0.995
## 8 86 Post-Smoothing dominanthand 0.800 0.876 0.864 0.860 0.605
## 9 88 Post-Smoothing dominanthand 0.724 0.853 0.793 0.759 0.628
## 10 89 Post-Smoothing dominanthand 0.832 0.880 0.890 0.901 0.615
## # … with abbreviated variable names ¹Precision, ²F1.score, ³Sensitivity,
## # ⁴Specificityres = seq_along(bothhands) %>% lapply(function(i) t.test(domhand[,i], bothhands[,i]))
names(res) = colnames(domhand)
res## $Accuracy
##
## Welch Two Sample t-test
##
## data: domhand[, i] and bothhands[, i]
## t = -0.11578, df = 17.942, p-value = 0.9091
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -0.1134180 0.1015724
## sample estimates:
## mean of x mean of y
## 0.8300817 0.8360044
##
##
## $Precision
##
## Welch Two Sample t-test
##
## data: domhand[, i] and bothhands[, i]
## t = -0.56908, df = 17.85, p-value = 0.5764
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -0.05909722 0.03391730
## sample estimates:
## mean of x mean of y
## 0.9114512 0.9240411
##
##
## $F1.score
##
## Welch Two Sample t-test
##
## data: domhand[, i] and bothhands[, i]
## t = -0.065236, df = 17.971, p-value = 0.9487
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -0.09020273 0.08477025
## sample estimates:
## mean of x mean of y
## 0.8757743 0.8784905
##
##
## $Sensitivity
##
## Welch Two Sample t-test
##
## data: domhand[, i] and bothhands[, i]
## t = 0.083773, df = 17.98, p-value = 0.9342
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -0.1153932 0.1249770
## sample estimates:
## mean of x mean of y
## 0.8591650 0.8543731
##
##
## $Specificity
##
## Welch Two Sample t-test
##
## data: domhand[, i] and bothhands[, i]
## t = -0.60458, df = 17.974, p-value = 0.553
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -0.17644645 0.09759436
## sample estimates:
## mean of x mean of y
## 0.7407652 0.7801912Both Hands NPC=3 per hand
Training 1 med session
metrics_df_long = metrics_df %>% filter(pca == 'bothhands', npc==3) %>% group_by(patient, smooth) %>% select(Accuracy, Precision, F1.score, Sensitivity, Specificity) %>% summarize_all(mean) %>% pivot_longer(-c(patient, smooth), names_to = "Metric")
metrics_df_long %>% ggplot(aes(x=Metric, y = value, color=Metric)) + geom_jitter() + geom_boxplot(alpha=0) + facet_wrap(~smooth) +
theme_bw() + ggtitle("Summary metrics for Movelet prediction (1 session training)") + theme(plot.title = element_text(hjust = 0.5)) +
scale_color_d3()
Metrics across sessions
# Prepare table with smoothing
table1 = metrics_df %>% filter(smooth=="Pre-Smoothing", pca == 'bothhands', npc==3) %>% group_by(session) %>% select(Accuracy, Precision, F1.score, Sensitivity, Specificity) %>% summarize_all(mean)
# Prepare table without smoothing
table2 = metrics_df %>% filter(smooth=="Post-Smoothing", pca == 'bothhands', npc==3) %>% group_by(session) %>% select(Accuracy, Precision, F1.score, Sensitivity, Specificity) %>% summarize_all(mean) %>% as.data.frame()
# Join tables
tables = cbind(table1, table2[, -1]) %>% round(2)
colnames(tables)[2:11] = paste0(colnames(tables)[2:11], rep(c(".T", ".F"), each = 5))
headers = data.frame(col_keys = colnames(tables),
from = c("Session", rep(c("Pre-Smoothing", "Post-Smoothing"), each=5)),
names = c("Session", colnames(cbind(table1[-1], table2[, -1])))
)
# Print table as flextable
tables %>% flextable::flextable() %>%
set_header_df(mapping = headers, key = "col_keys") %>%
merge_h(part="header") %>%
merge_v(part="header") %>%
theme_vanilla() %>%
width(width = 27, unit = "in") %>%
align(align="center", part="all") %>%
vline(part="header")Session | Pre-Smoothing | Post-Smoothing | ||||||||
|---|---|---|---|---|---|---|---|---|---|---|
Accuracy | Precision | F1.score | Sensitivity | Specificity | Accuracy | Precision | F1.score | Sensitivity | Specificity | |
5 | 0.83 | 0.93 | 0.88 | 0.84 | 0.80 | 0.88 | 0.94 | 0.92 | 0.90 | 0.82 |
6 | 0.81 | 0.92 | 0.86 | 0.81 | 0.79 | 0.86 | 0.94 | 0.90 | 0.87 | 0.83 |
8 | 0.81 | 0.92 | 0.86 | 0.83 | 0.76 | 0.86 | 0.92 | 0.90 | 0.89 | 0.76 |
9 | 0.78 | 0.91 | 0.84 | 0.79 | 0.77 | 0.83 | 0.93 | 0.87 | 0.84 | 0.81 |
11 | 0.78 | 0.89 | 0.84 | 0.80 | 0.71 | 0.81 | 0.89 | 0.86 | 0.85 | 0.70 |
12 | 0.73 | 0.89 | 0.79 | 0.73 | 0.74 | 0.78 | 0.92 | 0.83 | 0.79 | 0.77 |
Metrics across training modes
metrics_df_all_n %>%
filter(pca == 'bothhands', npc==3) %>%
group_by(patient, n_train, smooth) %>%
select(Accuracy, Precision, F1.score, Sensitivity, Specificity) %>%
summarize_all(mean) %>%
pivot_longer(-c(patient, n_train, smooth), names_to = "Metric") %>%
ggplot(aes(x=n_train, y = value, color=as.factor(n_train))) +
geom_jitter() + facet_grid(smooth~Metric) + geom_boxplot(alpha=0) +
theme_bw() + ggtitle("Summary metrics for Movelet prediction (n session training)") +
theme(plot.title = element_text(hjust = 0.5)) + guides(color=guide_legend(title="N trained med sessions")) + xlab("Train N") +
scale_color_lancet() 
Both Hands NPC=4
Training 1 med session
metrics_df_long = metrics_df %>% filter(pca == 'bothhands', npc==4) %>% group_by(patient, smooth) %>% select(Accuracy, Precision, F1.score, Sensitivity, Specificity) %>% summarize_all(mean) %>% pivot_longer(-c(patient, smooth), names_to = "Metric")
metrics_df_long %>% ggplot(aes(x=Metric, y = value, color=Metric)) + geom_jitter() + geom_boxplot(alpha=0) + facet_wrap(~smooth) +
theme_bw() + ggtitle("Summary metrics for Movelet prediction (1 session training)") + theme(plot.title = element_text(hjust = 0.5)) +
scale_color_d3()
Metrics across sessions
# Prepare table with smoothing
table1 = metrics_df %>% filter(smooth=="Pre-Smoothing", pca == 'bothhands', npc==4) %>% group_by(session) %>% select(Accuracy, Precision, F1.score, Sensitivity, Specificity) %>% summarize_all(mean)
# Prepare table without smoothing
table2 = metrics_df %>% filter(smooth=="Post-Smoothing", pca == 'bothhands', npc==4) %>% group_by(session) %>% select(Accuracy, Precision, F1.score, Sensitivity, Specificity) %>% summarize_all(mean) %>% as.data.frame()
# Join tables
tables = cbind(table1, table2[, -1]) %>% round(2)
colnames(tables)[2:11] = paste0(colnames(tables)[2:11], rep(c(".T", ".F"), each = 5))
headers = data.frame(col_keys = colnames(tables),
from = c("Session", rep(c("Pre-Smoothing", "Post-Smoothing"), each=5)),
names = c("Session", colnames(cbind(table1[-1], table2[, -1])))
)
# Print table as flextable
tables %>% flextable::flextable() %>%
set_header_df(mapping = headers, key = "col_keys") %>%
merge_h(part="header") %>%
merge_v(part="header") %>%
theme_vanilla() %>%
width(width = 27, unit = "in") %>%
align(align="center", part="all") %>%
vline(part="header")Session | Pre-Smoothing | Post-Smoothing | ||||||||
|---|---|---|---|---|---|---|---|---|---|---|
Accuracy | Precision | F1.score | Sensitivity | Specificity | Accuracy | Precision | F1.score | Sensitivity | Specificity | |
5 | 0.84 | 0.93 | 0.89 | 0.85 | 0.79 | 0.88 | 0.93 | 0.92 | 0.91 | 0.79 |
6 | 0.82 | 0.92 | 0.87 | 0.83 | 0.78 | 0.87 | 0.93 | 0.91 | 0.89 | 0.80 |
8 | 0.81 | 0.92 | 0.87 | 0.83 | 0.76 | 0.85 | 0.93 | 0.90 | 0.88 | 0.78 |
9 | 0.80 | 0.92 | 0.85 | 0.81 | 0.78 | 0.85 | 0.93 | 0.89 | 0.86 | 0.81 |
11 | 0.79 | 0.90 | 0.85 | 0.81 | 0.73 | 0.82 | 0.91 | 0.87 | 0.86 | 0.71 |
12 | 0.74 | 0.90 | 0.79 | 0.73 | 0.75 | 0.77 | 0.91 | 0.81 | 0.78 | 0.74 |
Metrics across traning modes
metrics_df_all_n %>%
filter(pca == 'bothhands', npc==4) %>%
group_by(patient, n_train, smooth) %>%
select(Accuracy, Precision, F1.score, Sensitivity, Specificity) %>%
summarize_all(mean) %>%
pivot_longer(-c(patient, n_train, smooth), names_to = "Metric") %>%
ggplot(aes(x=n_train, y = value, color=as.factor(n_train))) +
geom_jitter() + facet_grid(smooth~Metric) + geom_boxplot(alpha=0) +
theme_bw() + ggtitle("Summary metrics for Movelet prediction (n session training)") +
theme(plot.title = element_text(hjust = 0.5)) + guides(color=guide_legend(title="N trained med sessions")) + xlab("Train N") +
scale_color_lancet() 
Both Hands NPC=5
Training 1 med session
metrics_df_long = metrics_df %>% filter(pca == 'bothhands', npc==5) %>% group_by(patient, smooth) %>% select(Accuracy, Precision, F1.score, Sensitivity, Specificity) %>% summarize_all(mean) %>% pivot_longer(-c(patient, smooth), names_to = "Metric")
metrics_df_long %>% ggplot(aes(x=Metric, y = value, color=Metric)) + geom_jitter() + geom_boxplot(alpha=0) + facet_wrap(~smooth) +
theme_bw() + ggtitle("Summary metrics for Movelet prediction (1 session training)") + theme(plot.title = element_text(hjust = 0.5)) +
scale_color_d3()
Metrics across sessions
# Prepare table with smoothing
table1 = metrics_df %>% filter(smooth=="Pre-Smoothing", pca == 'bothhands', npc==5) %>% group_by(session) %>% select(Accuracy, Precision, F1.score, Sensitivity, Specificity) %>% summarize_all(mean)
# Prepare table without smoothing
table2 = metrics_df %>% filter(smooth=="Post-Smoothing", pca == 'bothhands', npc==5) %>% group_by(session) %>% select(Accuracy, Precision, F1.score, Sensitivity, Specificity) %>% summarize_all(mean) %>% as.data.frame()
# Join tables
tables = cbind(table1, table2[, -1]) %>% round(2)
colnames(tables)[2:11] = paste0(colnames(tables)[2:11], rep(c(".T", ".F"), each = 5))
headers = data.frame(col_keys = colnames(tables),
from = c("Session", rep(c("Pre-Smoothing", "Post-Smoothing"), each=5)),
names = c("Session", colnames(cbind(table1[-1], table2[, -1])))
)
# Print table as flextable
tables %>% flextable::flextable() %>%
set_header_df(mapping = headers, key = "col_keys") %>%
merge_h(part="header") %>%
merge_v(part="header") %>%
theme_vanilla() %>%
width(width = 27, unit = "in") %>%
align(align="center", part="all") %>%
vline(part="header")Session | Pre-Smoothing | Post-Smoothing | ||||||||
|---|---|---|---|---|---|---|---|---|---|---|
Accuracy | Precision | F1.score | Sensitivity | Specificity | Accuracy | Precision | F1.score | Sensitivity | Specificity | |
5 | 0.84 | 0.92 | 0.89 | 0.86 | 0.78 | 0.89 | 0.94 | 0.93 | 0.93 | 0.80 |
6 | 0.81 | 0.92 | 0.86 | 0.83 | 0.78 | 0.86 | 0.93 | 0.89 | 0.87 | 0.82 |
8 | 0.82 | 0.92 | 0.87 | 0.84 | 0.76 | 0.86 | 0.93 | 0.90 | 0.90 | 0.75 |
9 | 0.80 | 0.91 | 0.85 | 0.82 | 0.76 | 0.85 | 0.93 | 0.89 | 0.87 | 0.80 |
11 | 0.79 | 0.90 | 0.84 | 0.81 | 0.71 | 0.84 | 0.93 | 0.88 | 0.87 | 0.76 |
12 | 0.73 | 0.89 | 0.78 | 0.73 | 0.73 | 0.75 | 0.90 | 0.79 | 0.76 | 0.76 |
Metrics across traning modes
metrics_df_all_n %>%
filter(pca == 'bothhands', npc==5) %>%
group_by(patient, n_train, smooth) %>%
select(Accuracy, Precision, F1.score, Sensitivity, Specificity) %>%
summarize_all(mean) %>%
pivot_longer(-c(patient, n_train, smooth), names_to = "Metric") %>%
ggplot(aes(x=n_train, y = value, color=as.factor(n_train))) +
geom_jitter() + facet_grid(smooth~Metric) + geom_boxplot(alpha=0) +
theme_bw() + ggtitle("Summary metrics for Movelet prediction (n session training)") +
theme(plot.title = element_text(hjust = 0.5)) + guides(color=guide_legend(title="N trained med sessions")) + xlab("Train N") +
scale_color_lancet() 
Dominant Hand
Training 1 med session
metrics_df_long = metrics_df %>% filter(pca == 'dominanthand') %>% group_by(patient, smooth) %>% select(Accuracy, Precision, F1.score, Sensitivity, Specificity) %>% summarize_all(mean) %>% pivot_longer(-c(patient, smooth), names_to = "Metric")
metrics_df_long %>% ggplot(aes(x=Metric, y = value, color=Metric)) + geom_jitter() + geom_boxplot(alpha=0) + facet_wrap(~smooth) +
theme_bw() + ggtitle("Summary metrics for Movelet prediction (1 session training)") + theme(plot.title = element_text(hjust = 0.5)) +
scale_color_d3()
Metrics across sessions
# Prepare table with smoothing
table1 = metrics_df %>% filter(smooth=="Pre-Smoothing", pca == 'dominanthand') %>% group_by(session) %>% select(Accuracy, Precision, F1.score, Sensitivity, Specificity) %>% summarize_all(mean)
# Prepare table without smoothing
table2 = metrics_df %>% filter(smooth=="Post-Smoothing", pca == 'dominanthand') %>% group_by(session) %>% select(Accuracy, Precision, F1.score, Sensitivity, Specificity) %>% summarize_all(mean) %>% as.data.frame()
# Join tables
tables = cbind(table1, table2[, -1]) %>% round(2)
colnames(tables)[2:11] = paste0(colnames(tables)[2:11], rep(c(".T", ".F"), each = 5))
headers = data.frame(col_keys = colnames(tables),
from = c("Session", rep(c("Pre-Smoothing", "Post-Smoothing"), each=5)),
names = c("Session", colnames(cbind(table1[-1], table2[, -1])))
)
# Print table as flextable
tables %>% flextable::flextable() %>%
set_header_df(mapping = headers, key = "col_keys") %>%
merge_h(part="header") %>%
merge_v(part="header") %>%
theme_vanilla() %>%
width(width = 27, unit = "in") %>%
align(align="center", part="all") %>%
vline(part="header")Session | Pre-Smoothing | Post-Smoothing | ||||||||
|---|---|---|---|---|---|---|---|---|---|---|
Accuracy | Precision | F1.score | Sensitivity | Specificity | Accuracy | Precision | F1.score | Sensitivity | Specificity | |
5 | 0.82 | 0.91 | 0.87 | 0.85 | 0.73 | 0.87 | 0.92 | 0.91 | 0.91 | 0.74 |
6 | 0.78 | 0.90 | 0.84 | 0.80 | 0.72 | 0.84 | 0.91 | 0.89 | 0.87 | 0.74 |
8 | 0.81 | 0.90 | 0.86 | 0.83 | 0.72 | 0.87 | 0.92 | 0.91 | 0.92 | 0.73 |
9 | 0.79 | 0.90 | 0.85 | 0.81 | 0.74 | 0.84 | 0.92 | 0.88 | 0.86 | 0.76 |
11 | 0.76 | 0.88 | 0.82 | 0.77 | 0.70 | 0.82 | 0.90 | 0.86 | 0.85 | 0.72 |
12 | 0.71 | 0.89 | 0.76 | 0.69 | 0.75 | 0.74 | 0.91 | 0.79 | 0.74 | 0.75 |
Metrics across traning modes
metrics_df_all_n %>%
filter(pca == 'dominanthand') %>%
group_by(patient, n_train, smooth) %>%
select(Accuracy, Precision, F1.score, Sensitivity, Specificity) %>%
summarize_all(mean) %>%
pivot_longer(-c(patient, n_train, smooth), names_to = "Metric") %>%
ggplot(aes(x=n_train, y = value, color=as.factor(n_train))) +
geom_jitter() + facet_grid(smooth~Metric) + geom_boxplot(alpha=0) +
theme_bw() + ggtitle("Summary metrics for Movelet prediction (n session training)") +
theme(plot.title = element_text(hjust = 0.5)) + guides(color=guide_legend(title="N trained med sessions")) + xlab("Train N") +
scale_color_lancet() 